home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / slatex / proctex2.ss < prev    next >
Text File  |  1993-11-07  |  11KB  |  297 lines
  1. ;proctex2.ss
  2. ;SLaTeX Version 1.99
  3. ;Implements SLaTeX's piggyback to LaTeX
  4. ;...continued from proctex.ss
  5. ;(c) Dorai Sitaram, Dec 1991, Rice University
  6.  
  7. (define process-tex-file
  8.   (lambda (raw-filename)
  9.     ;call slatex on the .tex file raw-filename
  10.     ;(display* #f "begin " raw-filename eoln) 
  11.     (let ((filename (full-texfile-name raw-filename)))
  12.       (if (not filename)
  13.       (display* #f #\[ raw-filename #\]) ;didn't find it
  14.       (call-with-input-file filename
  15.         (lambda (in)
  16.           (let ((done? #f))
  17.         (let loop ()
  18.           (if done? 'exit-loop
  19.               (begin
  20.                (let ((c (read-char in)))
  21.              (cond
  22.               ((eof-object? c) (set! done? #t))
  23.               ((char=? c #\%) (eat-till-newline in))
  24.               ((char=? c #\\)
  25.                (let ((cs (read-ctrl-seq in)))
  26.                  (if seen-first-command? 'skip
  27.                      (begin
  28.                   (set! seen-first-command? #t)
  29.                   (decide-latex-or-tex
  30.                    (string=? cs "documentstyle"))))
  31.                  (cond 
  32.                   ((not *slatex-enabled?*)
  33.                    (if (string=? cs *slatex-reenabler*)
  34.                    (enable-slatex-again)))
  35.                   ((string=? cs "slatexignorecurrentfile")
  36.                    (set! done? #t))
  37.                   ((string=? cs "slatexdisable")
  38.                    (disable-slatex-temply in))
  39.                   ((string=? cs "begin")
  40.                    (let ((cs (read-grouped-latexexp in)))
  41.                  (cond
  42.                   ((member cs *display-triggerers*)
  43.                    (trigger-scheme2tex 'envdisplay
  44.                                in cs))
  45.                   ((member cs *box-triggerers*)
  46.                    (trigger-scheme2tex 'envbox
  47.                                in cs))
  48.                   ((member cs *region-triggerers*)
  49.                    (trigger-region 'envregion
  50.                            in cs)))))
  51.                   ((member cs *intext-triggerers*)
  52.                    (trigger-scheme2tex 'intext in #f))
  53.                   ((member cs *resultintext-triggerers*)
  54.                    (trigger-scheme2tex 'resultintext in #f))
  55.                   ((member cs *display-triggerers*)
  56.                    (trigger-scheme2tex 'plaindisplay 
  57.                            in cs))
  58.                   ((member cs *box-triggerers*)
  59.                    (trigger-scheme2tex 'plainbox
  60.                            in cs))
  61.                   ((member cs *region-triggerers*)
  62.                    (trigger-region 'plainregion
  63.                            in cs))
  64.                   ((member cs *input-triggerers*)
  65.                    (process-scheme-file (read-filename in)))
  66.                   ((string=? cs "input")
  67.                    (fluid-let ((*slatex-in-protected-region?*
  68.                             #f))
  69.                   (process-tex-file (read-filename in))))
  70.                   ((string=? cs "include")
  71.                    (if *latex?*
  72.                        (let ((f (full-texfile-name
  73.                                  (read-filename in))))
  74.                          (if (and f (member f *include-onlys*))
  75.                              (fluid-let 
  76.                                ((*slatex-in-protected-region?*
  77.                                   #f))
  78.                                (process-tex-file f))))))
  79.                   ((string=? cs "includeonly")
  80.                    (if *latex?* (process-include-only in)))
  81.                   ((string=? cs "documentstyle")
  82.                    (if *latex?* (process-documentstyle in)))
  83.                   ((string=? cs "schemecasesensitive")
  84.                    (process-case-info in))
  85.                   ((string=? cs "defschemetoken") 
  86.                    (process-slatex-alias in adjoin-string
  87.                             'intext))
  88.                   ((string=? cs "undefschemetoken")
  89.                    (process-slatex-alias in remove-string!
  90.                             'intext))
  91.                   ((string=? cs "defschemeresulttoken")
  92.                    (process-slatex-alias in adjoin-string
  93.                             'resultintext))
  94.                   ((string=? cs "undefschemeresulttoken")
  95.                    (process-slatex-alias in remove-string!
  96.                             'resultintext))
  97.                   ((string=? cs "defschemedisplaytoken")
  98.                    (process-slatex-alias in adjoin-string 
  99.                             'display))
  100.                   ((string=? cs "undefschemedisplaytoken")
  101.                    (process-slatex-alias in remove-string!
  102.                             'display))
  103.                   ((string=? cs "defschemeboxtoken")
  104.                    (process-slatex-alias in adjoin-string
  105.                             'box))
  106.                   ((string=? cs "undefschemeboxtoken")
  107.                    (process-slatex-alias in remove-string!
  108.                             'box))
  109.                   ((string=? cs "defschemeinputtoken")
  110.                    (process-slatex-alias in adjoin-string
  111.                             'input))
  112.                   ((string=? cs "undefschemeinputtoken")
  113.                    (process-slatex-alias in remove-string!
  114.                             'input))
  115.                   ((string=? cs "defschemeregiontoken")
  116.                    (process-slatex-alias in adjoin-string
  117.                             'region))
  118.                   ((string=? cs "undefschemeregiontoken")
  119.                    (process-slatex-alias in remove-string!
  120.                             'region))
  121.                   ((string=? cs "defschememathescape")
  122.                    (process-slatex-alias in adjoin-char
  123.                             'mathescape))
  124.                   ((string=? cs "undefschememathescape")
  125.                    (process-slatex-alias in remove-char!
  126.                             'mathescape))
  127.                   ((string=? cs "setkeyword")
  128.                    (add-to-slatex-db in 'keyword))
  129.                   ((string=? cs "setconstant")
  130.                    (add-to-slatex-db in 'constant))
  131.                   ((string=? cs "setvariable")
  132.                    (add-to-slatex-db in 'variable))
  133.                   ((string=? cs "setspecialsymbol")
  134.                    (add-to-slatex-db in 'setspecialsymbol))
  135.                   ((string=? cs "unsetspecialsymbol")
  136.                    (add-to-slatex-db in 'unsetspecialsymbol))
  137.                   )))))
  138.                (loop)))))))))
  139.     ;(display* #f "end " raw-filename eoln)
  140.     ))
  141.  
  142. (define process-scheme-file
  143.   (lambda (raw-filename)
  144.     ;typeset the scheme file raw-filename so that it can
  145.     ;be input as a .tex file
  146.     (let ((filename (full-scmfile-name raw-filename)))
  147.       (if (not filename)
  148.       (lwarning "process-scheme-file: " raw-filename " doesn't exist")
  149.       (let ((aux.tex (new-aux-file ".tex")))
  150.         (display* #f ".")
  151.         (if (file-exists? aux.tex) (delete-file aux.tex))
  152.         (call-with-input-file filename
  153.           (lambda (in)
  154.         (call-with-output-file aux.tex
  155.           (lambda (out)
  156.             (fluid-let ((*intext?* #f)
  157.                 (*code-env-spec* "ZZZZschemecode"))
  158.               (scheme2tex in out))))))
  159.         (if *slatex-in-protected-region?*
  160.           (set! *protected-files* (cons aux.tex *protected-files*)))
  161.         (process-tex-file filename))))))
  162.  
  163. (define trigger-scheme2tex
  164.   (lambda (typ in env)
  165.     ;process the slatex command identified by typ;
  166.     ;env is the name of the environment
  167.     (let* ((aux (new-aux-file)) (aux.ss (string-append aux ".ss"))
  168.        (aux.tex (string-append aux ".tex")))
  169.       (if (file-exists? aux.ss) (delete-file aux.ss))
  170.       (if (file-exists? aux.tex) (delete-file aux.tex))
  171.       (display* #f ".")
  172.       (call-with-output-file aux.ss
  173.     (lambda (out)
  174.       (cond ((memq typ '(intext resultintext)) (dump-intext in out))
  175.         ((memq typ '(envdisplay envbox))
  176.          (dump-display in out (string-append "\\end{" env "}")))
  177.         ((memq typ '(plaindisplay plainbox))
  178.          (dump-display in out (string-append "\\end" env)))
  179.         (else (lerror 'trigger-scheme2tex 1)))))
  180.       (call-with-input-file aux.ss
  181.     (lambda (in)
  182.       (call-with-output-file aux.tex
  183.         (lambda (out)
  184.           (fluid-let
  185.         ((*intext?* (memq typ '(intext resultintext)))
  186.          (*code-env-spec*
  187.            (cond ((eq? typ 'intext) "ZZZZschemecodeintext")
  188.              ((eq? typ 'resultintext) 
  189.               "ZZZZschemeresultintext")
  190.              ((memq typ '(envdisplay plaindisplay))
  191.               "ZZZZschemecode")
  192.              ((memq typ '(envbox plainbox))
  193.               "ZZZZschemecodebox")
  194.              (else (lerror 'trigger-scheme2tex 2)))))
  195.         (scheme2tex in out))))))
  196.       (if *slatex-in-protected-region?*
  197.     (set! *protected-files* (cons aux.tex *protected-files*)))
  198.       (if (memq typ '(envdisplay plaindisplay envbox plainbox))
  199.           (process-tex-file aux.tex))
  200.       (delete-file aux.ss))))
  201.  
  202. (define trigger-region
  203.   (lambda (typ in env)
  204.     ;process a scheme region to create a in-lined file with
  205.     ;slatex output
  206.     (let ((aux.tex (new-primary-aux-file ".tex"))
  207.       (aux2.tex (new-secondary-aux-file ".tex")))
  208.       (if (file-exists? aux2.tex) (delete-file aux2.tex))
  209.       (if (file-exists? aux.tex) (delete-file aux.tex))
  210.       (display* #f ".")
  211.       (fluid-let ((*slatex-in-protected-region?* #t)
  212.           (*protected-files* '()))
  213.     (call-with-output-file aux2.tex
  214.       (lambda (out)
  215.         (cond ((eq? typ 'envregion)
  216.            (dump-display in out (string-append "\\end{" env "}")))
  217.           ((eq? typ 'plainregion)
  218.            (dump-display in out (string-append "\\end" env)))
  219.           (else (lerror 'trigger-region)))))
  220.     (process-tex-file aux2.tex)
  221.     (set! *protected-files* (reverse! *protected-files*))
  222.     (call-with-input-file aux2.tex
  223.       (lambda (in)
  224.         (call-with-output-file aux.tex
  225.           (lambda (out)
  226.             (inline-protected-files in out)))))
  227.     (delete-file aux2.tex)))))
  228.  
  229. (define inline-protected-files
  230.   (lambda (in out)
  231.     ;inline all the protected files in port in into port out
  232.     (let ((done? #f))
  233.       (let loop ()
  234.     (if done? 'exit-loop
  235.             (begin
  236.           (let ((c (read-char in)))
  237.         (cond ((eof-object? c) (set! done? #t))
  238.               ((char=? c #\%) (eat-till-newline in))
  239.               ((char=? c #\\)
  240.                (let ((cs (read-ctrl-seq in)))
  241.              (cond
  242.                ((string=? cs "begin")
  243.                 (let ((cs (read-grouped-latexexp in)))
  244.                   (cond ((member cs *display-triggerers*)
  245.                      (inline-protected 
  246.                     'envdisplay in out cs))
  247.                     ((member cs *box-triggerers*)
  248.                      (inline-protected 'envbox in out cs))
  249.                     ((member cs *region-triggerers*)
  250.                      (inline-protected 
  251.                     'envregion in out cs))
  252.                     (else (display* out "\\begin{"
  253.                          cs "}")))))
  254.                    ((member cs *intext-triggerers*)
  255.                (inline-protected 'intext in out #f))
  256.               ((member cs *resultintext-triggerers*)
  257.                (inline-protected 'resultintext in out #f))
  258.                   ((member cs *display-triggerers*)
  259.                (inline-protected 'plaindisplay in out cs))
  260.               ((member cs *box-triggerers*)
  261.                (inline-protected 'plainbox in out cs))
  262.               ((member cs *region-triggerers*)
  263.                (inline-protected 'plainregion in out cs))
  264.               ((member cs *input-triggerers*)
  265.                (inline-protected 'input in out cs))
  266.               (else (display* out "\\" cs)))))
  267.             (else (display c out))))
  268.           (loop)))))))
  269.  
  270. (define inline-protected
  271.   (lambda (typ in out env)
  272.     (cond ((eq? typ 'envregion)
  273.        (display* out "\\begin{" env "}")
  274.        (dump-display in out (string-append "\\end{" env "}"))
  275.        (display* out "\\end{" env "}"))
  276.       ((eq? typ 'plainregion)
  277.        (display* out "\\" env)
  278.        (dump-display in out (string-append "\\end" env))
  279.        (display* out "\\end" env))
  280.       (else (let ((f (car *protected-files*)))
  281.             (set! *protected-files* (cdr *protected-files*))
  282.           (call-with-input-file f
  283.             (lambda (in)
  284.               (inline-protected-files in out)))
  285.           (delete-file f))
  286.         (cond ((memq typ '(intext resultintext))
  287.                (dump-intext in #f))
  288.               ((memq typ '(envdisplay envbox))
  289.                (dump-display in #f 
  290.              (string-append "\\end{" env "}")))
  291.               ((memq typ '(plaindisplay plainbox))
  292.                (dump-display in #f (string-append "\\end" env)))
  293.               ((eq? typ 'input) 
  294.                (read-filename in)) ;and throw it away
  295.               (else (lerror 'inline-protected)))))))
  296.  
  297.